home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / wheels2.arc / SCREEN.PAS < prev    next >
Pascal/Delphi Source File  |  1985-06-28  |  4KB  |  126 lines
  1. {@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
  2. The purchaser of these procedures and functions may include them in COMPILED
  3. programs freely, but may not sell or give away the source text.
  4.  
  5.     This is a little game using the procedures in SCREEN.LIB.
  6.  
  7. }
  8. {$I regpack.typ}
  9. {$I cursor.lib}
  10. {$I monitor.lib}
  11. {$I screen.lib}
  12. {$I getkeys.lib}
  13. type
  14.   charSet = set of char;
  15. const
  16.   arrows : charSet = [#24,#25,#26,#27];
  17. var
  18.   M, N, col, row, hitCol, hitRow : byte;
  19.   C, D, mover    : char;
  20.   DEAD, FOUND    : boolean;
  21.  
  22. begin
  23.   sound(1000);
  24.   delay(10);
  25.   NoSound;
  26.   WriteLn('This is a demonstration of the SCREEN procedures.  You will see ');
  27.   WriteLn('an arrow on the screen, and a HORNED BEAST in reverse video.');
  28.   WriteLn('As you press the cursor keys, the arrow is quickly written');
  29.   WriteLn('across the screen.  If you move onto your own path (sensed by');
  30.   WriteLn('READSCREEN), you die.  If you move onto the BEAST, you live.');
  31.   WriteLn('Either way, the screen attribute then gets rapidly changed');
  32.   WriteLn;
  33.   WriteLn('When you are writing to the screen this way, it''s nice to turn');
  34.   WriteLn('the cursor OFF.  Use procedure Cursor_control from CURSOR.LIB.');
  35.   WriteLn('  Press a key');
  36.   repeat until keypressed;
  37.   Cursor_control(48,0);  { 48 is the magic number that sets bits
  38.                            5 and 6, thus turning off the cursor}
  39.   ClrScr;
  40.   DEAD := false;
  41.   FOUND := false;
  42.   CheckColor;
  43.   col := random(80)+1;
  44.   row := random(25)+1;
  45.   WriteScreen(col,row,#153,112);
  46.   col := random(80)+1;
  47.   row := random(25)+1;
  48.   mover := chr(random(4)+24);
  49.   repeat
  50.     WriteScreen(col,row,mover,15);
  51.     repeat
  52.       GetKeys(C,D)
  53.     until (C = #27) and (D in ['H','K','M','P']);
  54.     case D of
  55.       'H': if row > 1 then
  56.              begin
  57.                row := row - 1;
  58.                mover := #24;
  59.                if ReadScreen(col,row) in arrows then DEAD := true;
  60.                if ReadScreen(col,row) = #153 then FOUND := true;
  61.              end;
  62.       'K': if col > 1 then
  63.              begin
  64.                col := col - 1;
  65.                mover := #27;
  66.                if ReadScreen(col,row) in arrows then DEAD := true;
  67.                if ReadScreen(col,row) = #153 then FOUND := true;
  68.              end;
  69.       'P': if row < 25 then
  70.              begin
  71.                row := row + 1;
  72.                mover := #25;
  73.                if ReadScreen(col,row) in arrows then DEAD := true;
  74.                if ReadScreen(col,row) = #153 then FOUND := true;
  75.              end;
  76.       'M': if col < 80 then
  77.              begin
  78.                col := col + 1;
  79.                mover := #26;
  80.                if ReadScreen(col,row) in arrows then DEAD := true;
  81.                if ReadScreen(col,row) = #153 then FOUND := true;
  82.              end;
  83.     end; {case}
  84.   until DEAD or FOUND;
  85.   if found then
  86.     begin
  87.       hitCol := col;
  88.       hitRow := row;
  89.       for M := 1 to 5 do
  90.        for N := 1 to 5 do
  91.         for col := hitCol-2 to hitCol+2 do
  92.          for row := hitRow-1 to hitRow+1 do
  93.           begin
  94.             WriteScreen(col,row,chr(((N+col) mod 2)+11),15+((M mod 2)*97));
  95.             delay(5);
  96.           end
  97.     end
  98.   else
  99.     begin
  100.       GotoXY(col,row);
  101.       Write('  YOU ARE DEAD ');
  102.     end;
  103.   delay(1000);
  104.   for col := 1 to 80 do
  105.     for row := 1 to 25 do
  106.       begin
  107.         ScreenAttribute(col,row,112);
  108.         sound(col*row*5);
  109.       end;
  110.   for col := 1 to 80 do
  111.     for row := 1 to 25 do
  112.       begin
  113.         ScreenAttribute(col,row,1);
  114.         sound(col*row*5+500);
  115.       end;
  116.   for col := 80 downto 1 do
  117.     for row := 1 to 25 do
  118.       begin
  119.         ScreenAttribute(col,row,15);
  120.         sound(col*row*5);
  121.       end;
  122.    nosound;
  123.    if color then                { In monochrome mode, the normal cursor }
  124.      cursor_control(6,7)        { consists of scan lines 12 and 13.  In }
  125.    else cursor_control(12,13);  { color, it's 6 and 7.                  }
  126. end.